home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / PROLOG / HUMBOLT / HUMBOLTS / _files / _humboltsr / MISC._c < prev    next >
Text File  |  1990-06-10  |  5KB  |  186 lines
  1. /***************************************************
  2. ****************************************************
  3. **                                                **
  4. **  HU-Prolog     Portable Interpreter System     **
  5. **                                                **
  6. **  Release 1.62   January  1990                  **
  7. **                                                **
  8. **  Authors:      C.Horn, M.Dziadzka, M.Horn      **
  9. **                                                **
  10. **  (C) 1989      Humboldt-University             **
  11. **                Department of Mathematics       **
  12. **                GDR 1086 Berlin, P.O.Box 1297   **
  13. **                                                **
  14. ****************************************************
  15. ***************************************************/
  16.  
  17. #include "systems.h"
  18. #include "atoms.h"
  19. #include "types.h"
  20. #include "errors.h"
  21. #include "manager.h"
  22.  
  23. IMPORT TERM A0,A1,A2;            /* from evalpreds.c     */
  24. IMPORT int BCT;
  25. IMPORT boolean INTRES(); /* from unify.c         */
  26. #if LONGARITH
  27. IMPORT boolean LONGRES();        /* from unify.c         */
  28. #endif
  29. IMPORT long TIMER();             /* from systems.c       */
  30. #if !RISCOS
  31. IMPORT struct tm *localtime();   /* from clib            */
  32. IMPORT long time();              /* from clib            */
  33. #endif
  34. IMPORT boolean UNIFY();          /* from unify.c         */
  35. IMPORT ENV E;
  36. IMPORT void SYSTEMERROR();
  37. /*
  38. EXPORT boolean DOTIME(),DOTIMER();
  39. EXPORT boolean DOANCESTORS()
  40. */
  41.  
  42. /**************************************************/
  43. /*               date & time                      */
  44. /**************************************************/
  45.  
  46. #if !CPM 
  47.  
  48. #include <time.h>
  49.  
  50. #if !RISCOS
  51. LOCAL long LTIME;
  52. LOCAL struct tm *TIMEREC;
  53. #else
  54. LOCAL time_t LTIME;
  55. LOCAL struct tm *TIMEREC;
  56. #endif
  57.  
  58. GLOBAL boolean DOTIME(ATOM A)
  59. { 
  60.  (void)time(<IME);
  61.  TIMEREC=localtime(<IME);
  62.  switch(A)
  63.  {
  64.      case TIME_3:
  65.          return INTRES(A0,TIMEREC->tm_hour) && 
  66.          INTRES(A1,TIMEREC->tm_min) && 
  67.          INTRES(A2,TIMEREC->tm_sec); 
  68.      case DATE_3:
  69.          return  INTRES(A0,TIMEREC->tm_year) &&
  70.          INTRES(A1,TIMEREC->tm_mon + 1) &&
  71.          INTRES(A2,TIMEREC->tm_mday);
  72.     case WEEKDAY_1:
  73.          return INTRES(A0,(TIMEREC->tm_wday?TIMEREC->tm_wday:7));
  74.     default:
  75.          SYSTEMERROR("misc.c/DOTIME");
  76.  }
  77. #if lint
  78.  return false;
  79. #endif
  80. }
  81.  
  82. #endif
  83.  
  84. GLOBAL boolean DOTIMER(void)
  85. { static long STARTTIME,CURRTIME;
  86.          CURRTIME=TIMER();
  87.          if(name(A0)==INTT)
  88.            { STARTTIME=CURRTIME-(long)ival(A0); return true; }
  89.          else
  90. #if LONGARITH
  91.          if(name(A0)==LONGT)
  92.            { STARTTIME=CURRTIME-longval(A0); return true; }
  93.          else return LONGRES(A0,CURRTIME-STARTTIME);
  94. #endif
  95. #if ! LONGARITH
  96.          return INTRES(A0,(int)(CURRTIME-STARTTIME));
  97. #endif
  98. }
  99.  
  100.  
  101. GLOBAL boolean DOANCESTORS(void)
  102. {
  103.     TERM T,TT,C;
  104.     ENV CE;
  105.  
  106.     TT=mkfunc(CONS_2,mk2sons(UNBOUNDT,nil_term,NIL_0,nil_term)); T=TT;
  107.     for(CE=E;CE;CE=env(CE))
  108.         if((C=call(CE)) && name(C)!=SEMI_2 && name(C)!=COMMA_2)
  109.         {   T=son(T); 
  110.             (void)UNIFY(1,T,C,BE,base(env(CE)),MAXDEPTH);
  111.             next_br(T);
  112.             name(T)=CONS_2;
  113.             son(T)=mk2sons(UNBOUNDT,nil_term,NIL_0,nil_term);
  114.         }
  115.     name(T)=NIL_0; son(T)=nil_term;
  116.     return UNI(A0,TT);
  117. }
  118.  
  119.  
  120.  
  121. GLOBAL boolean islist(register TERM T, boolean ascii)
  122. {
  123.     int counter=0;
  124.     deref(T);
  125.     while(name(T)==CONS_2)
  126.     {
  127.         if(ascii)
  128.       {
  129.             register TERM TT;
  130.             TT=arg1(T);
  131.             if(name(TT) !=INTT) return false;
  132.             if(ival(TT) < 0 || ival(TT) > 255) return false;
  133.         }
  134.         T=arg2(T);
  135.         if(counter++ > MAXTERMS) return false; /* zyklic term */
  136.     }
  137.     return (name(T)==NIL_0);
  138. }
  139.  
  140. GLOBAL boolean DOMEMBER(void)
  141. {
  142.   register int I=0;
  143.   register TERM T,TT;
  144.   register ATOM A;
  145.   T=A1; A=name(A0);
  146.   while (I<BCT && name(T)==CONS_2) { T=br(son(T)); deref(T); I++; }
  147.   if (I!=BCT) ARGERROR();
  148.   while (name(T)==CONS_2)
  149.   { BCT++;
  150.     TT=son(T); deref(TT);
  151.     if (name(TT)==UNBOUNDT) return UNI(son(T),A0);
  152.     if (A==UNBOUNDT || name(TT)==A) if (UNI(son(T),A0)) return true;
  153.     if (BCT>100000) return false; /* probably cyclic term */
  154.     T=br(son(T));
  155.     deref(T);
  156.   }
  157.   return false;
  158. }
  159.  
  160. static TERM TAIL;
  161.  
  162. static TERM append(register TERM X)
  163. { register TERM Z;
  164.   register TERM Y;
  165.   if (name(X)==NIL_0) return son(TAIL);
  166.   if (name(X)!=CONS_2) ARGERROR();
  167.   {  X=son(X); Y=br(X);
  168.      deref(X); deref(Y);
  169.      Z=mk2sons(name(X),son(X),CONS_2,append(Y));
  170.      return Z;
  171.   }
  172. }
  173.  
  174. GLOBAL boolean DOAPPEND(void)
  175. {
  176.   TERM X;
  177.   if (name(A0)==NIL_0) return UNI(A1,A2);
  178.   if (name(A1)==NIL_0) return UNI(A0,A2);
  179.   X=mkfreevar(); TAIL=mkfreevar();
  180.   UNI(X,A0); UNI(TAIL,A1);
  181.   deref(X);
  182.   return UNI(mkfunc(CONS_2,append(X)),A2);
  183. }
  184.  
  185.  
  186.